perm filename ITMSUB.F4[RST,LCS] blob sn#205521 filedate 1976-03-12 generic text, type T, neo UTF8
00100	C**** ITMSUB, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200	C  ********** WHOLE & HALF RESTS, BEAMS ******
00300		SUBROUTINE ITMSUB
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600		COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,RG,RH/BM/RA,RC,RJY
00800		COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900		COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000		1 RJA,YY,DISX,HGT,RZ,INP(53)
01100		COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
01200		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(R11,
01300		1RJQ(9)),(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01400		1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01500		1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01600		DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01700		1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
01800	C  RDBR IS SPACER FOR DBL BAR.
01900	C  RTF COMPENSATES FOR BAD PLANNING.
02000		RST7=RSTJ2*7.
02100		RST18=RSTJ2*18.
02200	C  TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02300	
02400		R3Q=R3
02500	C   NEXT DRAWS STRAIGHT LINES
02600	
02700		RD=R4*RST7
02800		RA=0
02900		RX=RTF*RSTJ2+POS
03000	C  SOMEDAY ADD < RDIS=1./DIS >  TO REPLACE ALL 1./DIS'S
03010		J10=J10*DIS*RSTJ2
03020	C THICKNESS DEPENDS ON FINAL SIZE FACTOR (DIS) AND STAFF SIZE.(???!!)
03100		IF(J5.EQ.50)GO TO 300
03200	C  50 IS FOR CRESC., DECRESC. AND BOXES
03300		IF(R6.NE.0)GO TO 401
03400		IF(J7.NE.0)GO TO 401
03500	C  FOR BAR LINES
03600	4000	JA=44
03700	C  CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
03800	C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
03900		DBR=0 
04000		IF(J4.LT.1000)GO TO 400
04100	C  J4=1001 = DBL BAR,  =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04200	CK	J4=J4-1000
04300	CK	DBR=-1
04400	CK400	J7=(J4/100)*DIS
04500		DBR=J4/1000
04600		J4=J4-DBR*1000
04700	C DBR=1 HEAVY BAR IS ON RT.  =2 ON LEFT.  =3 IN MIDDLE.
04800	9400	RD=RDBR+RDBR*RSTJ2
04900	C  TO SPACE THIN BAR FROM HEAVY
05000		IF(J5.EQ.0)GO TO 400
05100	C  NEXT ADDS REPEAT DOTS TO DBL BAR.
05200		L=J4
05300		RJ=L/100
05400		IF(RJ.EQ.0)RJ=6.*RSTJ2
05500	C HEAVY BAR WILL BE 5 LINES WIDE.
05600		RZ=R3
05700		J4=0
05800	C  MUST BE 0 FOR DOTS IN 'NOTWRT'
05900		IF(DBR.EQ.0)DBR=J5
06000		J5=0
06100	C J5=1 RPT ←, =2 RPT →, =3 RPT ↔
06200		RJA=RD*2.
06300	C  TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
06400		JY=DBR
06500		IF(DBR.LT.2)GO TO 8400
06600		R3=RJA+RJ+RZ
06700	7400	DO 3400 K=J2,MOD(L,100)+J2-1
06800		RSTJ2=RSTFAC(K)
06900		POS=STFF(K)
07000		R4=6
07100		CALL CENTX
07200	C  SPACES DOTS OUT FROM BAR
07300		CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
07400	C  GO GET THE DOT
07500		R4=8
07600		CALL CENTX
07700	3400	CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
07800		JY=JY-1
07900		IF(JY.LT.2)GO TO 4400
08000	8400	R3=RZ-RJA-4.*RSTJ2
08100		GO TO 7400
08200	C  DO I NEED ANY MORE RESETS????
08300	4400	J4=L
08400		J7=RJ*DIS
08500		GO TO 5400
08600	400	IF(J5.NE.0)GO TO 9400
08700		K=J4/100
08800	C  K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
08900		J7=K*DIS
09000	C  J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
09100	5400	L=MOD(J4,100)
09200		IF(L.EQ.0)L=1
09300		L=L+J2-1
09400	C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
09500		RA=RTF
09600		IF(L.LE.4)GO TO 2400
09700		L=4
09800		RA=300.
09900	C FOR EXTENDING BARS ABOVE STAFF 4
10000	2400	RY=RSTFAC(L)
10100		RZ=R3Q
10200	C  SAVE IT FOR DBL RPT BAR.
10300		RY=STFF(L)+(RA+56.)*RY
10400	1400	RA=1
10500		IF(PLT.GE.0)GO TO 140
10600		J7=J7+1
10700		RA=1./DIS
10800	C  BAR LINES PLOT AS DOUBLE THICKNESS
10900	140	RJX=R3Q
11000	42	CALL LINES(R3Q,RX,3)
11100		RJ=-1.
11200		RW=RY
11300	406	CALL LINES(RJX,RY,2)
11400		IF(J10.EQ.0)GO TO 411
11500	C  P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
11600		J7=J10
11700		J10=0
11800		RA=1./DIS
11900	411	IF(J7.GT.0)GO TO 409
12000		IF(DBR.LE.0)RETURN
12100		RY=RW
12200	CK	R3Q=R3Q-RDBR
12300		RA=RZ-RD
12400		IF(DBR.NE.1)RA=RJX+RD-1.
12500		DBR=DBR-2
12600		R3Q=RA
12700		GO TO 1400
12800	CC411	IF(J7.LE.0)RETURN
12900	C  FOR 'HEAVY' LINE.
13000	409	RJX=RJX+RA
13100		CALL LINES(RJX,RY,2)
13200		J7=J7-1
13300		RY=RW
13400		IF(RJ)RY=RX
13500		RJ=-RJ
13600		GO TO 406
13700	CC43	IF(RA.LE.0)RETURN
13800	C   HOW IS RA.NE.0?
13900	C  DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
14000	CC403	RA=RA-3.72
14100	CC	R3Q=R3Q+22
14200	CC	RJX=RJX+22
14300	C   DO ABOVE NEED *RSTJ2? ************
14400	C **** BASED ON '596' ****
14500	CC	GO TO 42
14600	
14700	C  FOR CRESC., DECRESC.
14800	300	IF(R7.EQ.0)R7=2.3
14900		IF(R7.EQ.-1.)R7=-2.3
15000		RA=ABS(R7/2.0)*RST7
15100	C   AMOUNT OF SPREAD
15200		RJ=R3Q
15300		RX=RX-RST18+RD
15400		IF(R8.NE.0)GO TO 302
15500	C  JUMP TO MAKE BOX
15600		R6=RHORZ(R6)
15700		IF(R7)GO TO 301
15800		RJ=R6
15900		R6=R3Q
16000	301	CALL LINX(RJ,RX+RA,R6,RX)
16100		CALL LINES(RJ,RX-RA,2)
16200	C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
16300	CC	IF(PLT.NE.-2)RETURN
16400		IF(PLT.GE.0)RETURN
16500	C  THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
16600		IF(J8)RETURN
16700		RX=RX+1./DIS
16800		J8=-1
16900	C FOR DOUBLE THICKNESS
17000		GO TO 301
17100	
17200	302	R8=R8*RST7
17300		R9=R9*RST7
17400		IF(R9.EQ.0)R9=R8
17500	C  R9=0 MAKES SQUARE    
17600		R3=R3Q-R8/2.
17700		RX=RX-R9/2.
17710		RY=RX
17720		IF(R11.NE.0)RY=RY+R11*RST7
17730	C R11 IS OFFSET FOR PARALLELAGRAM
17800		J10=J10
17900	C  DRAWS BOX, CENTER IS IN MIDDLE 
18000	C  4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
18100	1302	CALL LINX(R3,RX,R3+R8,RY)
18200		CALL LINES(R3+R8,RY+R9,2)
18300		CALL LINES(R3,RX+R9,2)
18400		CALL LINES(R3,RX,2)
18500		IF(J10.EQ.0)RETURN
18600		J10=J10-1
18700		RJ=1./DIS
18800		R3=R3-RJ
18900		R8=R8+RJ+RJ
19000		RX=RX-RJ
19010		RY=Ry-RJ
19100		R9=R9+RJ+RJ
19200		GO TO 1302
19300	C  TO THICKEN BOXES.
19400	
19500	1401	R4=2.0
19600	C FOR HEAVY BRACK.
19700		RA=RSTJ2*RBX
19800		RX=RX-RA
19900	C  THE BOTTOM
20000		L=J4+J2-1
20100		R6=RTF
20200		IF(L.LE.4)GO TO 4401
20300		L=4
20400		R6=300.
20500	4401	RA=STFF(L)
20600	C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
20700		RJY=RSTFAC(L)
20800		RY=RA+R6*RJY+RJY*56.+RJY*RBX
20900	C  THE TOP
21000		R5=9.5
21100		GO TO 2401
21200	
21300	C  DASHES
21400	401	POS=POS-RST18
21500	C********* 27/9/72 ******
21600		IF(J7.LE.0)GO TO 407
21700		IF(J7.EQ.4)GO TO 1401
21800		IF(J7.NE.3)GO TO 4001
21900	C  NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
22000	2401	JA=3
22100		IF(J10.EQ.0)J10=5
22200	C  DEFAULT VALUE FOR THICKNESS =5
22300		R4=R4-RBR
22400		J9=0
22500		J5=35
22600	C  THE NUM FOR THE LITTLE END ITEMS
22700	CC	RY=R6-2.1*RSTJ2
22800		R6=3 
22900		R7=0
23000	C DOES LOWER ONE FIRST.  ITEM IS IN 'CLEF3.DMD' ON DAT.LCS
23100		IF(J8.NE.2)CALL CLEFS
23200	C P8=1=BOTTOM 1/2 BRACK. ONLY:  =2=TOP 1/2 ONLY:  0=COMPLETE
23300		R4=R5-RBR
23400		R6=3
23500		R7=-3
23600	C  TURNS IT UPSIDE DOWN.
23700	CC	JA=3
23800		IF(J7.NE.4)GO TO 3401
23900		POS=RA
24000		R4=R4*RJY/RSTJ2
24100	C  TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
24200	3401	IF(J8.NE.1)CALL CLEFS
24300		R3Q=R3Q-12.0*RSTJ2
24400		IF(J7.NE.4)GO TO 407
24500		J7=0
24600		GO TO 140
24700	
24800	4002	J5=4
24900	C FOR CURVY BRACKET.  P6 CAN CHANGE WIDTH.
25000		R8=0
25100		J4=J4+J2-1
25200		R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
25300	C  .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
25400	C  ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
25500		IF(R6.EQ.0)R6=1.+R7/20.
25600		JA=3
25700		R4=2.3
25800	C  C  BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*⊗
25900		CALL CLEFS
26000		RETURN
26100	
26200	4001	IF(J7.EQ.5)GO TO 4002
26300		IF(R8.EQ.0)R8=.8
26400	C  P8 CAN SET SIZE OF DASH
26402		RZ=5.96*RSTJ2
26405		RJ=R8*RZ
26410		RZ=R9*RZ
26420		IF(R9.EQ.0)RZ=RJ
26430	C  P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)
26440		R8=RJ
26450		R9=RZ
26500		RD=RD+POS
26600		RJX=RD
26700	C =1 =DASHES,  P6=P3=VERTICAL; P4=P5=HORIZ.; OTHERWISE SLOPE.
26800		J6=ROFF(RHORZ(R6))
26900		J3=J6-J3
27000		J4=J5-J4
27100		RJY=RD
27200	C SAVE FOR THICK LINES
27300		RA=J6
27400	C RA IS HORIZ. GOAL FOR DASHES
27500	402	RY=POS+R5*RST7
27600		IF(J4.EQ.0)GO TO 41
27700		RH=RY-RD
27800	C TOTAL HEIGHT DIFF.
27900		RX=RA-R3
28000	C TOTAL LENGTH DIFF.
28100		RH=RH/RX
28200	41	L=3
28300		K=2
28400	416	CALL LINES(R3Q,RD,L)
28405		IF(J3.EQ.0)GO TO 412
28407	C  JUMP FOR VERT. DASH
28410		IF(J3.GT.0)GO TO 422
28420		IF(R3Q.LE.RA)GO TO 413
28425	C THIS IF P6 IS LESS THAN P3
28430		R3Q=R3Q-RJ
28440		GO TO 423
28500	422	IF(R3Q.GE.RA)GO TO 413
28600	C  JUMP IF ALL DONE
28700		R3Q=R3Q+RJ
28710	423	IF(J4.NE.0)RD=RJY+RH*(R3Q-R3)
28720	C  FINDS HEIGHT OF RIGHT SIDE OF SLOPE
28800	414	CALL EXCH(L,K)
28810		CALL EXCH(RJ,RZ)
28820	C  EXCH. SPACE AND DASH SIZE.
28900		GO TO 416
28950	412	IF(J4.GT.0)GO TO 424
28960		IF(RD.LE.RY)GO TO 413
28970		RD=RD-RJ
28980	C  THIS IF P5 IS LESS THAN P4.
28990		GO TO 414
29000	424	IF(RD.GE.RY)GO TO 413
29100	C  JUMP IF DONE
29200		RD=RD+RJ
29300		GO TO 414
29400	413	IF(J10.GT.0)GO TO 420
29410		IF(J11.EQ.0)RETURN
29415		IF(J3)RJ=-RJ
29420		IF(L.EQ.3)R3Q=R3Q-RJ
29430		RX=R8
29440		IF(J11)RX=-RX
29450		CALL LINX(R3Q,RD,R3Q,RD+RX)
29460	C PUTS BRACK END ON DASHED LINE. (P11=1 OR -1)
29470		RETURN
29480	
29500	C  NEXT FOR THICK DASHES
29600	420	J10=J10-1
29650		RJ=1./DIS
29700		IF(J3.EQ.0)GO TO 415
29800		R3Q=R3
29900		RJY=RJY+RJ
29950		RD=RJY
30000		GO TO 417
30100	415	R3Q=R3Q+RJ
30200		RD=RJX
30210	417	RJ=R8
30220		RZ=R9
30230	C  FOR THICK DASHES.
30300		GO TO 41
30400	
30500	
30600	407	RX=RD+POS
30700		RY=R5*RST7+POS
30800		IF(J7.EQ.3)GO TO 140
30900		CALL NOZERO(R9)
31000		IF(J7.EQ.-1)GO TO 408
31100	C  FOR 'TR' J7=-2, 'ARPEGG' J7=-1,  STRAIGHT LINES J7=0
31200	CC  WHY THE IFIX????	RJX=IFIX(RHORZ(R6))
31300		RJX=IFIX(ROFF(RHORZ(R6)))
31400	C  ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
31500		IF(J7.EQ.0)GO TO 42
31600		RY=R9*RST7+RX
31700		CALL NOZERO(R8)
31800	4041	RZ=RX
31900		RH=RY
32000	C  SAVE FOR THICK WIGGLES
32100		CALL LINES(R3Q,RX,3)
32200	C  DRAWS STRAIGHT LINES. ETC.
32300		R9=R3Q
32400		RJ=RY
32500		RW=3.*RSTJ2*R8
32600		RA=RW*2.5
32700	C  P8=HORZ. WIGGLE SIZE;  P9=VERT. SIZE
32800	404	R9=R9+RA
32900		CALL LINES(R9,RJ,2)
33000		R9=R9+RW
33100		CALL LINES(R9,RJ,2)
33200	405	CALL EXCH(RX,RJ)
33300		IF(R9.LT.RJX)GO TO 404
33400		IF(J10.LE.0)RETURN
33450		RY=1./DIS
33500		RX=RZ+RY
33600		RY=RH+RY
33700		J10=J10-1
33800		GO TO 4041
33900	C  P10= + NUM OF THICKNESSES TO WIGGLE
34000	
34100	408	IF(RX.GT.RY)CALL EXCH(RX,RY)
34200		RZ=R9*RSTJ2*5.96
34300	C  USE P9 TO SET WIGGLE WIDTH.  P8 TO SET HGT.
34400		CALL NOZERO(R8)
34500		RD=R8*RST7*.5
34600		RJ=RD
34700		IF(RD.LT.1.)RD=1.
34800	421	R9=RX
34900		RW=R3Q
35000		RA=RZ+R3Q
35100		CALL LINES(RW,R9,3)
35200	410	R9=R9+RJ
35300		CALL LINES(RA,R9,2)
35400		R9=R9+RD
35500		CALL LINES(RA,R9,2)
35600		CALL EXCH(RA,RW)
35700		IF(R9.LT.RY)GO TO 410
35800		IF(J10.LE.0)RETURN
35900		R3Q=R3Q+1./DIS
36000		J10=J10-1
36100		GO TO 421
36200	C  VERTICAL WIGGLE   P10=+ NUM OF THICKNESSES.
36300		END